home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / win-os2.swg / 0028_WINDOWS Error Collection.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  1.8 KB  |  76 lines
  1. program RunTime213;
  2.  
  3. {
  4.    Written by:    Michele Mottini
  5.                   TERA S.r.l.
  6.                   CIS 100040,615
  7.  
  8. }
  9. uses
  10.   WinCrt,
  11.   WinTypes,
  12.   WinProcs,
  13.   Objects;
  14.  
  15. {-------------------- Class TErrCollection : collection with error management }
  16.  
  17. {
  18.   You can freely descend your own collection from TErrCollection getting
  19.   automatically enhanced run time error management.
  20. }
  21.  
  22. type
  23.   PErrCollection = ^TErrCollection;
  24.   TErrCollection = object(TCollection)
  25.     procedure Error(Code,Info : integer); virtual;
  26.   end;
  27.  
  28. procedure TErrCollection.Error(Code,Info : integer);
  29. var
  30.   ErrDesc : record
  31.     ErrCode : integer;
  32.     ErrPosHi : word;
  33.     ErrPosLo : word;
  34.     ErrIndex : integer;
  35.     ErrCount : integer;
  36.   end;
  37.   Buffer : array[0..80] of char;
  38. begin
  39.   asm
  40.     mov   cx,[BP+20]
  41.     mov   bx,[BP+22]
  42.     verr  bx
  43.     je    @1
  44.     mov   bx,$FFFF
  45.     mov   cx,bx
  46.     jmp   @2
  47. @1:
  48.     mov   es,bx
  49.     mov   bx,word ptr es:0
  50. @2:
  51.     mov   ErrDesc.ErrPosLo,cx
  52.     mov   ErrDesc.ErrPosHi,bx
  53.   end;
  54.   ErrDesc.ErrCode := 212-Code;
  55.   ErrDesc.ErrIndex := Info;
  56.   ErrDesc.ErrCount := Count;
  57.   WVSPrintF(Buffer,'Runtime error %d at %04X:%04X with index %d; Count=%d',ErrDesc);
  58.   MessageBox(0,Buffer,nil,mb_Ok or mb_SystemModal);
  59.   halt(0);
  60. end; { Error }
  61.  
  62. {----------------------------------------------------------------------- Main }
  63.  
  64. var
  65.   TestColl : TErrCollection;
  66.  
  67. begin
  68.   TestColl.Init(16,8);
  69.   writeln('Now the program call the At() function with an invalid index');
  70.   writeln('causing a R/Time error 213');
  71.   writeln;
  72.   writeln('If you try to find the error position from the address you will');
  73.   writeln('go to the correct line!');
  74.   TestColl.At(1);          { Wrong index: we will get a 213 R/Time error }
  75.   TestColl.Done;
  76. end.